home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 24 / CU Amiga Magazine's Super CD-ROM 24 (1998)(EMAP Images)(GB)(Track 1 of 2)[!][issue 1998-07].iso / CUCD / Programming / SWI / source / src / pl-read.c < prev    next >
Encoding:
C/C++ Source or Header  |  1998-03-24  |  47.8 KB  |  2,014 lines
  1. /*  $Id: pl-read.c,v 1.53 1998/03/24 13:39:13 jan Exp $
  2.  
  3.     Copyright (c) 1990 Jan Wielemaker. All rights reserved.
  4.     See ../LICENCE to find out about your rights.
  5.     jan@swi.psy.uva.nl
  6. */
  7.  
  8. #include <math.h>
  9. /*#define O_DEBUG 1*/
  10. #include "pl-incl.h"
  11. #include "pl-ctype.h"
  12.  
  13. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  14. This module defines the Prolog parser.  Reading a term takes two passes:
  15.  
  16.     * Reading the term into memory, deleting multiple blanks, comments
  17.       etc.
  18.     * Parsing this string into a Prolog term.
  19.  
  20. The separation has two reasons: we can call the  first  part  separately
  21. and  insert  the  read  strings in the history and we can produce better
  22. error messages as the parsed part of the source is available.
  23.  
  24. The raw reading pass is quite tricky as PCE requires  us  to  allow  for
  25. callbacks  from  C  during  this  process  and the callback might invoke
  26. another read.  Notable raw reading needs to be studied studied once more
  27. as it  takes  about  30%  of  the  entire  compilation  time  and  looks
  28. promissing  for  optimisations.   It  also  could  be  made  a  bit more
  29. readable.
  30.  
  31. This module is considerably faster when compiled  with  GCC,  using  the
  32. -finline-functions option.
  33. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  34.  
  35. forwards void    startRead(void);
  36. forwards void    stopRead(void);
  37. forwards void    errorWarning(char *);
  38. forwards void    singletonWarning(atom_t *, int);
  39. forwards void    clearBuffer(void);
  40. forwards void    addToBuffer(int);
  41. forwards char *    raw_read2(void);
  42. forwards char *    raw_read(void);
  43.  
  44. typedef struct token * Token;
  45. typedef struct variable * Variable;
  46.  
  47. struct token
  48. { int type;            /* type of token */
  49.   int start;            /* start-position */
  50.   int end;            /* end-position */
  51.   union
  52.   { number    number;        /* int or float */
  53.     atom_t    atom;        /* atom value */
  54.     term_t    term;        /* term (list or string) */
  55.     int        character;    /* a punctuation character (T_PUNCTUATION) */
  56.     Variable    variable;    /* a variable record (T_VARIABLE) */
  57.   } value;            /* value of token */
  58. };
  59.  
  60.  
  61. struct variable
  62. { char *    name;        /* Name of the variable */
  63.   term_t    variable;    /* Term-reference to the variable */
  64.   int        times;        /* Number of occurences */
  65.   word        signature;    /* Pseudo atom */
  66.   Variable     next;        /* Next of chain */
  67. };
  68.  
  69.  
  70. #define T_FUNCTOR    0    /* name of a functor (atom, followed by '(') */
  71. #define T_NAME        1    /* ordinary name */
  72. #define T_VARIABLE    2    /* variable name */
  73. #define T_VOID        3    /* void variable */
  74. #define T_NUMBER    4    /* integer or float */
  75. #define T_STRING    5    /* "string" */
  76. #define T_PUNCTUATION    6    /* punctuation character */
  77. #define T_FULLSTOP    7    /* Prolog end of clause */
  78.  
  79. extern int Input;        /* current input stream (from pl-file.c) */
  80. static unsigned char *here;        /* current character */
  81. static unsigned char *base;        /* base of clause */
  82. static unsigned char *token_start;    /* start of most recent read token */
  83. static char *last_syntax_error; /* last syntax error */
  84. static struct token token;    /* current token */
  85. static bool unget = FALSE;    /* unget_token() */
  86.  
  87. #define CHARESCAPE trueFeature(CHARESCAPE_FEATURE)
  88.  
  89. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  90. The reading function (raw_read()) can  be   called  recursively  via the
  91. notifier when running under event-driven packages  (like PCE).  To avoid
  92. corruption of the database we push the read buffer rb on a stack and pop
  93. in back when finished.  See raw_read() and raw_read2().
  94. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  95.  
  96. #define RBSIZE    512        /* initial size of read buffer */
  97. #define MAX_READ_NESTING 5    /* nesting of read (O_PCE only) */
  98.  
  99. static
  100. struct read_buffer
  101. { int    size;            /* current size of read buffer */
  102.   int    left;            /* left space in read buffer */
  103.   unsigned char *base;        /* base of read buffer */
  104.   unsigned char *here;        /* current position in read buffer */
  105.   int   stream;            /* stream we are reading from */
  106. } rb;
  107.  
  108. #if O_PCE
  109. static struct read_buffer rb_stack[MAX_READ_NESTING];
  110. int read_nesting = 0;        /* current nesting level */
  111. #endif /* O_PCE */
  112.  
  113. void
  114. resetRead(void)
  115. { 
  116. #if O_PCE
  117.   read_nesting = 0;
  118. #endif
  119. }
  120.  
  121. static
  122. void
  123. startRead(void)
  124. {
  125. #if O_PCE
  126.   if (read_nesting >= MAX_READ_NESTING)
  127.   { warning("Read stack too deeply nested");
  128.     pl_abort();
  129.   }
  130.   rb_stack[read_nesting++] = rb;
  131.   rb = rb_stack[read_nesting];
  132. #endif /* O_PCE */
  133.   rb.stream = Input;
  134.   source_file_name = currentStreamName();
  135. }
  136.  
  137. static void
  138. stopRead(void)
  139. {
  140. #if O_PCE
  141.   rb_stack[read_nesting] = rb;
  142.   rb = rb_stack[--read_nesting];
  143.   if (read_nesting < 0)
  144.     fatalError("Read stack underflow???");
  145. #endif /* O_PCE */
  146. }
  147.  
  148.         /********************************
  149.         *         ERROR HANDLING        *
  150.         *********************************/
  151.  
  152. static int give_syntaxerrors = TRUE;
  153.  
  154. int
  155. syntaxerrors(int new)
  156. { int old = give_syntaxerrors;
  157.   give_syntaxerrors = new;
  158.  
  159.   return old;
  160. }
  161.  
  162.  
  163. word
  164. pl_syntaxerrors(term_t old, term_t new)
  165. { return setBoolean(&give_syntaxerrors, "syntaxerrors", old, new);
  166. }
  167.  
  168.  
  169. #define syntaxError(what) { errorWarning(what); fail; }
  170.  
  171. static void
  172. errorWarning(char *what)
  173. { unsigned int c;
  174.   
  175.   if ( !give_syntaxerrors )
  176.   { source_char_no += token_start - base;
  177.     last_syntax_error = what;
  178.     return;
  179.   }
  180.  
  181.   c = *token_start;
  182.  
  183.   if ( !ReadingSource )            /* not reading from a file */
  184.   { Sfprintf(Serror, "\n[WARNING: Syntax error: %s \n", what);
  185.     *token_start = EOS;
  186.     Sfprintf(Serror, "%s\n** here **\n", base);  
  187.     if (c != EOS)
  188.     { *token_start = c;
  189.       Sfprintf(Serror, "%s]\n", token_start);
  190.     }
  191.   } else
  192.   { predicate_t pred = PL_pred(FUNCTOR_exception3, MODULE_user);
  193.     int rval;
  194.     unsigned char *s;
  195.  
  196.     for(s = base; s < token_start; s++ )
  197.     { if ( *s == '\n' )
  198.           source_line_no++;
  199.     }
  200.     
  201.     if ( pred->definition->definition.clauses )
  202.     { fid_t cid = PL_open_foreign_frame();
  203.       qid_t qid;
  204.       term_t argv = PL_new_term_refs(3);
  205.       term_t a    = PL_new_term_ref();
  206.     
  207.       PL_put_atom(    argv+0, ATOM_syntax_error);
  208.       PL_put_functor( argv+1, FUNCTOR_syntax_error3);
  209.       PL_put_variable(argv+2);
  210.       PL_get_arg(1, argv+1, a); PL_unify_atom(a, source_file_name);
  211.       PL_get_arg(2, argv+1, a); PL_unify_integer(a, source_line_no);
  212.       PL_get_arg(3, argv+1, a); PL_unify_atom_chars(a, what);
  213.            
  214.       qid = PL_open_query(MODULE_user, PL_Q_NODEBUG, pred, argv);
  215.       rval = PL_next_solution(qid);
  216.       PL_close_query(qid);
  217.       PL_discard_foreign_frame(cid);
  218.     } else
  219.       rval = FALSE;
  220.  
  221.     if ( !rval )
  222.       warning("%s:%d: Syntax error: %s",
  223.           stringAtom(source_file_name), source_line_no, what);
  224.   }
  225. }
  226.  
  227.  
  228. static void
  229. singletonWarning(atom_t *vars, int nvars)
  230. { fid_t cid = PL_open_foreign_frame();
  231.   qid_t qid;
  232.   term_t argv      = PL_new_term_refs(3);
  233.   term_t a         = PL_new_term_ref();
  234.   term_t h       = PL_new_term_ref();
  235.   predicate_t pred = PL_pred(FUNCTOR_exception3, MODULE_user);
  236.   int n, rval;
  237.     
  238.   PL_put_atom(    argv+0, ATOM_singleton);
  239.   PL_put_functor( argv+1, FUNCTOR_singleton3);
  240.   PL_put_variable(argv+2);
  241.   PL_get_arg(1, argv+1, a); PL_unify_atom(a, source_file_name);
  242.   PL_get_arg(2, argv+1, a); PL_unify_integer(a, source_line_no);
  243.   PL_get_arg(3, argv+1, a);
  244.            
  245.   for(n=0; n<nvars; n++)
  246.   { PL_unify_list(a, h, a);
  247.     PL_unify_atom(h, vars[n]);
  248.   }
  249.   PL_unify_nil(a);
  250.  
  251.   qid = PL_open_query(MODULE_user, PL_Q_NODEBUG, pred, argv);
  252.   rval = PL_next_solution(qid);
  253.   PL_close_query(qid);
  254.   PL_discard_foreign_frame(cid);
  255.  
  256.   if ( !rval )
  257.   { char buf[LINESIZ];
  258.  
  259.     buf[0] = EOS;
  260.     for(n=0; n<nvars; n++)
  261.     { if ( n > 0 )
  262.     strcat(buf, ", ");
  263.       strcat(buf, stringAtom(vars[n]));
  264.     }
  265.  
  266.     warning("Singleton variables: %s", buf);
  267.   }
  268. }
  269.  
  270.  
  271.         /********************************
  272.         *           RAW READING         *
  273.         *********************************/
  274.  
  275.  
  276. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  277. Scan the input, give prompts when necessary and return a char *  holding
  278. a  stripped  version of the next term.  Contigeous white space is mapped
  279. on a single space, block and % ... \n comment  is  deleted.   Memory  is
  280. claimed automatically en enlarged if necessary.
  281.  
  282. Earlier versions used to local stack for   building the term.  This does
  283. not work with O_PCE as we might be  called back via the notifier while
  284. reading.
  285.  
  286. (char *) NULL is returned on a syntax error.
  287. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  288.  
  289. static void
  290. clearBuffer()
  291. { if (rb.size == 0)
  292.   { if ( !(rb.base = (unsigned char *)malloc(RBSIZE)) )
  293.       fatalError("%s", OsError());
  294.     rb.size = RBSIZE;
  295.   }
  296.   SECURE( if ( rb.base == 0 ) fatalError("read/1: nesting=%d, size=%d",
  297.                         read_nesting, rb.size) );
  298.   rb.left = rb.size;
  299.   base = rb.here = rb.base;
  300.   DEBUG(8, Sdprintf("Cleared read buffer.rb at %ld, base at %ld\n",
  301.           (long) &rb, (long) rb.base));
  302. }      
  303.  
  304.  
  305. static inline void
  306. addToBuffer(int c)
  307. { if (rb.left-- == 0)
  308.   { if ( !(rb.base = (unsigned char *)realloc(rb.base, rb.size * 2)) )
  309.       fatalError("%s", OsError());
  310.     DEBUG(8, Sdprintf("Reallocated read buffer at %ld\n", (long) rb.base));
  311.     base = rb.base;
  312.     rb.here = rb.base + rb.size;
  313.     rb.left = rb.size - 1;
  314.     rb.size *= 2;
  315.   }
  316.   *rb.here++ = c & 0xff;
  317. }
  318.  
  319.  
  320. #define getchr() Sgetc(ioi)
  321.  
  322. #define ensure_space(c) { if ( something_read && \
  323.                    (c == '\n'|| !isBlank(rb.here[-1])) ) \
  324.                addToBuffer(c); \
  325.                 }
  326. #define set_start_line { if ( !something_read ) \
  327.              { setCurrentSourceLocation(); \
  328.                something_read++; \
  329.              } \
  330.                }
  331.  
  332. #define rawSyntaxError(what) { addToBuffer(EOS); \
  333.                    base = rb.base, token_start = rb.here-1; \
  334.                    syntaxError(what); \
  335.                  }
  336.  
  337. static char *
  338. raw_read2()
  339. { int c;
  340.   bool something_read = FALSE;
  341.   int newlines;
  342.   bool dotseen = FALSE;
  343.   IOSTREAM *ioi = PL_current_input();
  344.  
  345.   if ( !ioi )
  346.   { c = EOF;
  347.     goto handle_c;
  348.   }
  349.   
  350.   clearBuffer();                /* clear input buffer */
  351.   source_line_no = -1;
  352.  
  353.   for(;;)
  354.   { c = getchr();
  355.  
  356.   handle_c:
  357.     switch(c)
  358.     { case EOF:
  359.         if (seeingString())        /* do not require '. ' when */
  360.         { addToBuffer(' ');        /* reading from a string */
  361.           addToBuffer('.');
  362.           addToBuffer(' ');
  363.           addToBuffer(EOS);
  364.           return rb.base;
  365.         }
  366.         if (something_read)
  367.         { if ( dotseen )        /* term.<EOF> */
  368.           { if ( rb.here - rb.base == 1 )
  369.               rawSyntaxError("Unexpected end of clause");
  370.             ensure_space(' ');
  371.             addToBuffer(EOS);
  372.             return rb.base;
  373.           }
  374.           rawSyntaxError("Unexpected end of file");
  375.         }
  376.         if ( Sfpasteof(ioi) )
  377.         { warning("Attempt to read past end-of-file");
  378.           return NULL;
  379.         }
  380.         set_start_line;
  381.         strcpy(rb.base, "end_of_file. ");
  382.         return rb.base;
  383.       case '/': c = getchr();
  384.         if ( c == '*' )
  385.         { int last;
  386.           int level = 1;
  387.  
  388.           if ((last = getchr()) == EOF)
  389.             rawSyntaxError("End of file in ``/* ... */'' comment");
  390.  
  391.           if ( something_read )
  392.           { addToBuffer(' ');    /* positions */
  393.             addToBuffer(' ');
  394.             addToBuffer(last == '\n' ? last : ' ');
  395.           }
  396.  
  397.           for(;;)
  398.           { switch(c = getchr())
  399.             { case EOF:
  400.             rawSyntaxError("End of file in ``/* ... */'' comment");
  401.               case '*':
  402.             if ( last == '/' )
  403.               level++;
  404.             break;
  405.               case '/':
  406.             if ( last == '*' && --level == 0 )
  407.             { c = ' ';
  408.               goto handle_c;
  409.             }
  410.             break;
  411.             }
  412.             if ( something_read )
  413.               addToBuffer(c == '\n' ? c : ' ');
  414.             last = c;
  415.           }
  416.         } else
  417.         { addToBuffer('/');
  418.           if ( isSymbol(c) )
  419.           { while( c != EOF && isSymbol(c) )
  420.             { addToBuffer(c);
  421.               c = getchr();
  422.             }
  423.           }
  424.           dotseen = FALSE;
  425.           goto handle_c;
  426.         }
  427.       case '%': if ( something_read )
  428.           addToBuffer(' ');    /* positions */
  429.         while((c=getchr()) != EOF && c != '\n')
  430.         { if ( something_read )    /* record positions */
  431.             addToBuffer(' ');
  432.         }
  433.         c = '\n';
  434.         goto handle_c;
  435.      case '\'': if ( rb.here > rb.base && isDigit(rb.here[-1]) )
  436.         { addToBuffer(c);            /* <n>' */
  437.           if ( rb.here[-2] == '0' )        /* 0'<c> */
  438.           { if ( (c=getchr()) != EOF )
  439.             { addToBuffer(c);
  440.               break;
  441.             }
  442.             rawSyntaxError("Unexpected end of file");
  443.           }
  444.           dotseen = FALSE;
  445.           break;
  446.         }
  447.  
  448.         set_start_line;
  449.         newlines = 0;
  450.         addToBuffer(c);
  451.         while((c=getchr()) != EOF && c != '\'')
  452.         { if ( c == '\\' && CHARESCAPE )
  453.           { addToBuffer(c);
  454.             if ( (c = getchr()) == EOF )
  455.               goto eofinquoted;
  456.           } else if (c == '\n' &&
  457.                  newlines++ > MAXNEWLINES &&
  458.                  (debugstatus.styleCheck & LONGATOM_CHECK))
  459.             rawSyntaxError("Atom too long");
  460.  
  461.           addToBuffer(c);
  462.         }
  463.         if (c == EOF)
  464.         { eofinquoted:
  465.           rawSyntaxError("End of file in quoted atom");
  466.         }
  467.         addToBuffer(c);
  468.         dotseen = FALSE;
  469.         break;
  470.       case '"':    set_start_line;
  471.         newlines = 0;
  472.         addToBuffer(c);
  473.         while((c=getchr()) != EOF && c != '"')
  474.         { if ( c == '\\' && CHARESCAPE )
  475.           { addToBuffer(c);
  476.             if ( (c = getchr()) == EOF )
  477.               goto eofinstr;
  478.           } else if (c == '\n' &&
  479.                  newlines++ > MAXNEWLINES &&
  480.                  (debugstatus.styleCheck & LONGATOM_CHECK))
  481.             rawSyntaxError("String too long");
  482.           addToBuffer(c);
  483.         }
  484.         if (c == EOF)
  485.         { eofinstr:
  486.           rawSyntaxError("End of file in string");
  487.         }
  488.         addToBuffer(c);
  489.         dotseen = FALSE;
  490.         break;
  491.       case '.': addToBuffer(c);
  492.         set_start_line;
  493.         dotseen++;
  494.         c = getchr();
  495.         if ( isSymbol(c) )
  496.         { while( c != EOF && isSymbol(c) )
  497.           { addToBuffer(c);
  498.             c = getchr();
  499.           }
  500.           dotseen = FALSE;
  501.         }
  502.         goto handle_c;
  503.       default:    switch(_PL_char_types[c])
  504.         { case SP:
  505.             if ( dotseen )
  506.             { if ( rb.here - rb.base == 1 )
  507.             rawSyntaxError("Unexpected end of file");
  508.               ensure_space(c);
  509.               addToBuffer(EOS);
  510.               return rb.base;
  511.             }
  512.             do
  513.             { if ( something_read )
  514.             addToBuffer(c == '\n' ? c : ' '); /* positions */
  515.               else
  516.             ensure_space(c);
  517.               c = getchr();
  518.             } while( c != EOF && isBlank(c) );
  519.             goto handle_c;
  520.           case SY:
  521.             set_start_line;
  522.             do
  523.             { addToBuffer(c);
  524.               c = getchr();
  525.             } while( c != EOF && isSymbol(c) == SY );
  526.             dotseen = FALSE;
  527.             goto handle_c;
  528.           case LC:
  529.           case UC:
  530.             set_start_line;
  531.             do
  532.             { addToBuffer(c);
  533.               c = getchr();
  534.             } while( c != EOF && isAlpha(c) );
  535.             dotseen = FALSE;
  536.             goto handle_c;
  537.           default:
  538.             addToBuffer(c);
  539.             dotseen = FALSE;
  540.             set_start_line;
  541.         }
  542.     }
  543.   }
  544. }
  545.  
  546. static char *
  547. raw_read(void)
  548. { char *s;
  549.  
  550.   startRead();
  551.   if ( Input == 0 )
  552.   { ttybuf tab;
  553.  
  554.     PushTty(&tab, TTY_SAVE);        /* make sure tty is sane */
  555.     PopTty(&ttytab);
  556.     s = raw_read2();
  557.     PopTty(&tab);
  558.   } else
  559.     s = raw_read2();
  560.   stopRead();
  561.  
  562.   return s;
  563. }
  564.  
  565.  
  566.         /*********************************
  567.         *        VARIABLE DATABASE       *
  568.         **********************************/
  569.  
  570. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  571. These functions manipulate the  variable-name  base   for  a  term. When
  572. building the term on the global stack, variables are represented using a
  573. reference to a `struct variable'. The first  part of this structure is a
  574. struct atom, so if a garbage   collection happens, the garbage collector
  575. will simply assume an atom.
  576.  
  577. The buffer `var_buffer' is a  list  if   pointers  to  a  stock of these
  578. variable structures. This list is dynamically expanded if necessary. The
  579. buffer var_name_buffer contains the actually   strings.  They are packed
  580. together to avoid memory fragmentation. This   buffer too is reallocated
  581. if necessary. In this  case,  the   pointers  of  the  existing variable
  582. structures are relocated.
  583. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  584.  
  585. #define MAX_SINGLETONS 256
  586.  
  587. static buffer     var_name_buffer;    /* stores the names */
  588. static buffer     var_buffer;        /* array of Variables */
  589. static int     var_allocated;        /* # allocated slots there */
  590. static int     var_free;        /* 1-st free slot there */
  591. static Variable     var_list;        /* linked list of vars */
  592. static Variable  var_tail;        /* tail of linked list */
  593.  
  594. static void
  595. initVarTable()
  596. { static int done = 0;
  597.  
  598.   if ( !done )
  599.   { initBuffer(&var_name_buffer);
  600.     initBuffer(&var_buffer);
  601.     done++;
  602.   }
  603.  
  604.   var_list = var_tail = NULL;
  605.   var_free = 0;
  606.   emptyBuffer(&var_name_buffer);
  607. }
  608.  
  609.  
  610. static char *
  611. save_var_name(const char *name)
  612. { int l = strlen(name);
  613.   char *nb, *ob = baseBuffer(&var_name_buffer, char);
  614.   int e = entriesBuffer(&var_name_buffer, char);
  615.  
  616.   addMultipleBuffer(&var_name_buffer, name, l+1, char);
  617.   if ( (nb = baseBuffer(&var_name_buffer, char)) != ob )
  618.   { int shift = nb - ob;
  619.     Variable v;
  620.  
  621.     for(v = var_list; v; v = v->next)
  622.       v->name += shift;
  623.   }
  624.  
  625.   return baseBuffer(&var_name_buffer, char) + e;
  626. }
  627.  
  628.                     /* use hash-key? */
  629.  
  630. static Variable
  631. isVarAtom(word w)
  632. { if ( tagex(w) == (TAG_ATOM|STG_GLOBAL) )
  633.     return baseBuffer(&var_buffer, Variable)[w>>7];
  634.   
  635.   return NULL;
  636. }
  637.  
  638.  
  639. static Variable
  640. lookupVariable(const char *name)
  641. { Variable v;
  642.  
  643.   for( v = var_list; v; v = v->next )
  644.   { if ( streq(name, v->name) )
  645.     { v->times++;
  646.       return v;
  647.     }
  648.   }
  649.        
  650.   while ( var_free >= var_allocated )
  651.   { Variable v = allocHeap(sizeof(struct variable));
  652.     addBuffer(&var_buffer, v, Variable);
  653.     v->signature = (var_allocated<<7)|TAG_ATOM|STG_GLOBAL;
  654.     var_allocated++;
  655.   }
  656.  
  657.   v = baseBuffer(&var_buffer, Variable)[var_free++];
  658.   v->next     = NULL;
  659.   v->name     = save_var_name(name);
  660.   v->times    = 1;
  661.   v->variable = 0;
  662.   if ( var_tail )
  663.   { var_tail->next = v;
  664.     var_tail = v;
  665.   } else
  666.     var_list = var_tail = v;
  667.   
  668.   return v;
  669. }
  670.  
  671.  
  672. static bool
  673. check_singletons(term_t singles)
  674. { Variable var;
  675.  
  676.   if ( singles != TRUE )        /* returns <name> = var bindings */
  677.   { term_t list = PL_copy_term_ref(singles);
  678.     term_t head = PL_new_term_ref();
  679.  
  680.     for(var = var_list; var; var=var->next)
  681.     { if ( var->times == 1 && var->name[0] != '_' )
  682.       {    if ( !PL_unify_list(list, head, list) ||
  683.          !PL_unify_term(head,
  684.                 PL_FUNCTOR, FUNCTOR_equals2,
  685.                 PL_CHARS,    var->name,
  686.                 PL_TERM,    var->variable) )
  687.       fail;
  688.       }
  689.     }
  690.  
  691.     return PL_unify_nil(list);
  692.   } else                /* just report */
  693.   { atom_t singletons[MAX_SINGLETONS];
  694.     int i = 0;
  695.  
  696.     for(var = var_list; var; var=var->next)
  697.     { if ( var->times == 1 && var->name[0] != '_' )
  698.       { if ( singles == 1 )
  699.     { if ( i < MAX_SINGLETONS )
  700.         singletons[i++] = lookupAtom(var->name);
  701.     }
  702.       }
  703.     }
  704.  
  705.     if ( i > 0 )
  706.       singletonWarning(singletons, i);
  707.  
  708.     succeed;
  709.   }
  710. }
  711.  
  712.  
  713. static bool
  714. bind_variables(term_t bindings)
  715. { Variable var;
  716.   term_t list = PL_copy_term_ref(bindings);
  717.   term_t head = PL_new_term_ref();
  718.   term_t a    = PL_new_term_ref();
  719.  
  720.   for(var = var_list; var; var=var->next)
  721.   { if ( var->name[0] != '_' )
  722.     { if ( !PL_unify_list(list, head, list) ||
  723.        !PL_unify_functor(head, FUNCTOR_equals2) ||
  724.        !PL_get_arg(1, head, a) ||
  725.        !PL_unify_atom_chars(a, var->name) ||
  726.        !PL_get_arg(2, head, a) ||
  727.        !PL_unify(a, var->variable) )
  728.     fail;
  729.     }
  730.   }
  731.  
  732.   return PL_unify_nil(list);
  733. }
  734.  
  735.  
  736.         /********************************
  737.         *           TOKENISER           *
  738.         *********************************/
  739.  
  740. #define skipSpaces    { while(isBlank(*here) ) here++; c = *here++; }
  741. #define unget_token()    { unget = TRUE; }
  742.  
  743. forwards Token    get_token(bool);
  744. forwards void    build_term(term_t term, atom_t name, int arity, term_t *args);
  745. forwards bool    complex_term(const char *end, term_t term, term_t positions);
  746. forwards bool    simple_term(bool, term_t term, bool *isname, term_t positions);
  747.  
  748. static int
  749. scan_number(char **s, int b, Number n)
  750. { int d;
  751.   unsigned long maxi = PLMAXINT/b;    /* cache? */
  752.   unsigned long t = 0;
  753.  
  754.   while((d = digitValue(b, **s)) >= 0)
  755.   { (*s)++;
  756.  
  757.     if ( t > maxi )
  758.     { real maxf = MAXREAL / (real) b - (real) b;
  759.       real tf = (real)t;
  760.  
  761.       tf = tf * (real)b + (real)d;
  762.       while((d = digitValue(b, **s)) >= 0)
  763.       { (*s)++;
  764.         if ( tf > maxf )
  765.       fail;                /* number too large */
  766.         tf = tf * (real)b + (real)d;
  767.       }
  768.       n->value.f = tf;
  769.       n->type = V_REAL;
  770.       succeed;
  771.     } else
  772.       t = t * b + d;
  773.   }  
  774.  
  775.   if ( t > PLMAXINT )
  776.   { n->value.f = (real)t;
  777.     n->type = V_REAL;
  778.     succeed;
  779.   }
  780.  
  781.   n->value.i = t;
  782.   n->type = V_INTEGER;
  783.   succeed;
  784. }
  785.  
  786.  
  787. #define NEXT(v)    do { c = (v); goto next; } while(0) 
  788. #define AddChar(c) \
  789.     do \
  790.     { if ( n >= bufsize ) \
  791.       { if ( bufsize == 0 ) \
  792.         { bufsize = 512; \
  793.           buf = malloc(bufsize); \
  794.         } else \
  795.         { bufsize *= 2; \
  796.           buf = realloc(buf, bufsize); \
  797.         } \
  798.         if ( buf == NULL ) \
  799.           fatalError("%s", OsError()); \
  800.       } \
  801.       buf[n++] = (c); \
  802.     } while(0)
  803.         
  804.  
  805. static char *
  806. get_string(unsigned char *in, unsigned char **end)
  807. { static char *buf;
  808.   static int bufsize = 0;
  809.   int n;
  810.   int quote;
  811.   char c;
  812.  
  813.   n = 0;
  814.   quote = *in++;
  815.  
  816.   for(;;)
  817.   { c = *in++;
  818.  
  819.     if ( c == quote )
  820.     { if ( *in == quote )
  821.       { in++;
  822.     NEXT(quote);
  823.       }
  824.  
  825.       break;
  826.     }
  827.     if ( c == '\\' && CHARESCAPE )
  828.     { int c2;
  829.       int base;
  830.       int xdigits;
  831.       
  832.       switch((c2 = *in++))
  833.       { case 'a':
  834.       NEXT(7);            /* 7 is ASCII BELL */
  835.     case 'b':
  836.       NEXT('\b');
  837.     case 'c':
  838.       while(isBlank(*in))
  839.         in++;
  840.       continue;
  841.     case 10:            /* linefeed */
  842.       while(isBlank(*in) && *in != 10 )
  843.         in++;
  844.       continue;
  845.     case 'f':
  846.       NEXT('\f');
  847.     case 'n':
  848.       NEXT('\n');
  849.     case 'r':
  850.       NEXT('\r');
  851.     case 't':
  852.       NEXT('\t');
  853.     case 'v':
  854.       NEXT(11);            /* 11 is ASCII Vertical Tab */
  855.     case 'x':
  856.       c2 = *in++;
  857.       if ( digitValue(16, c2) >= 0 )
  858.       { base = 16;
  859.         xdigits = 1;
  860.         goto numchar;
  861.       } else
  862.         NEXT('x');
  863.     default:
  864.       if ( c2 >= '0' && c2 <= '7' )    /* octal number */
  865.       { int chr;
  866.         int dv;
  867.  
  868.         base = 8;
  869.         xdigits = 2;
  870.  
  871.       numchar:
  872.         chr = digitValue(base, c2);
  873.         c2 = *in++;
  874.         while(xdigits-- > 0 &&
  875.           (dv = digitValue(base, c2)) >= 0 )
  876.         { chr = chr * base + dv;
  877.           c2 = *in++;
  878.         }
  879.         if ( c2 != '\\' )
  880.           in--;
  881.         NEXT(chr);
  882.       } else
  883.         NEXT(c2);
  884.       }
  885.     }
  886.  
  887.   next:
  888.     AddChar(c);
  889.   }
  890.  
  891.   AddChar(EOS);
  892.   if ( end )
  893.     *end = in;
  894.  
  895.   return buf;
  896. }  
  897.  
  898.  
  899. int
  900. get_number(const unsigned char *cin, unsigned char **end, Number value)
  901. { int negative = FALSE;
  902.   unsigned int c;
  903.   char *in = (char *)cin;        /* const hack */
  904.  
  905.   if ( *in == '-' )            /* skip optional sign */
  906.   { negative = TRUE;
  907.     in++;
  908.   } else if ( *in == '+' )
  909.     in++;
  910.  
  911.   if ( *in == '0' )
  912.   { int base = 0;
  913.  
  914.     switch(in[1])
  915.     { case '\'':            /* 0'<char> */
  916.       { if ( isAlpha(in[3]) )
  917.       fail;                /* illegal number */
  918.     value->value.i = (long)in[2] & 0xff;
  919.     if ( negative )            /* -0'a is a bit dubious! */
  920.       value->value.i = -value->value.i;
  921.     *end = in+3;
  922.     value->type = V_INTEGER;
  923.     succeed;
  924.       }
  925.       case 'b':
  926.     base = 2;
  927.         break;
  928.       case 'x':
  929.     base = 16;
  930.         break;
  931.       case 'o':
  932.     base = 8;
  933.         break;
  934.     }
  935.  
  936.     if ( base )                /* 0b<binary>, 0x<hex>, 0o<oct> */
  937.     { int rval;
  938.       in += 2;
  939.       rval = scan_number(&in, base, value);
  940.       *end = in;
  941.       if ( negative )
  942.      value->value.i = -value->value.i;
  943.       return rval;
  944.     }
  945.   }
  946.  
  947.   if ( !isDigit(*in) || !scan_number(&in, 10, value) )
  948.     fail;                /* too large? */
  949.  
  950.                     /* base'value number */
  951.   if ( *in == '\'' )
  952.   { in++;
  953.  
  954.     if ( !intNumber(value) || value->value.i > 36 )
  955.       fail;                /* illegal base */
  956.     if ( !scan_number(&in, (int)value->value.i, value) )
  957.       fail;                /* number too large */
  958.  
  959.     if ( isAlpha(*in) )
  960.       fail;                /* illegal number */
  961.  
  962.     if ( negative )
  963.     { if ( intNumber(value) )
  964.     value->value.i = -value->value.i;
  965.       else
  966.     value->value.f = -value->value.f;
  967.     }
  968.  
  969.     *end = in;
  970.     succeed;
  971.   }
  972.                     /* Real numbers */
  973.   if ( *in == '.' && isDigit(in[1]) )
  974.   { double n;
  975.  
  976.     if ( intNumber(value) )
  977.     { value->value.f = (double) value->value.i;
  978.       value->type = V_REAL;
  979.     }
  980.     n = 10.0, in++;
  981.     while( isDigit(c = *in) )
  982.     { in++;
  983.       value->value.f += (double)(c-'0') / n;
  984.       n *= 10.0;
  985.     }
  986.   }
  987.  
  988.   if ( *in == 'e' || *in == 'E' )
  989.   { number exponent;
  990.     bool neg_exponent;
  991.  
  992.     in++;
  993.     DEBUG(9, Sdprintf("Exponent\n"));
  994.     switch(*in)
  995.     { case '-':
  996.     in++;
  997.         neg_exponent = TRUE;
  998.     break;
  999.       case '+':
  1000.     in++;
  1001.       default:
  1002.     neg_exponent = FALSE;
  1003.         break;
  1004.     }
  1005.  
  1006.     if ( !scan_number(&in, 10, &exponent) || !intNumber(&exponent) )
  1007.       fail;                /* too large exponent */
  1008.  
  1009.     if ( intNumber(value) )
  1010.     { value->value.f = (double) value->value.i;
  1011.       value->type = V_REAL;
  1012.     }
  1013.  
  1014.     value->value.f *= pow((double)10.0,
  1015.               neg_exponent ? -(double)exponent.value.i
  1016.                            : (double)exponent.value.i);
  1017.   }
  1018.  
  1019.   if ( negative )
  1020.   { if ( intNumber(value) )
  1021.       value->value.i = -value->value.i;
  1022.     else
  1023.       value->value.f = -value->value.f;
  1024.   }
  1025.  
  1026.   *end = in;
  1027.   succeed;
  1028. }
  1029.  
  1030.  
  1031. static Token
  1032. get_token(bool must_be_op)
  1033. { unsigned int c;
  1034.   unsigned char *start;
  1035.   int end;
  1036.  
  1037.   if ( unget )
  1038.   { unget = FALSE;
  1039.     return &token;
  1040.   }
  1041.  
  1042.   skipSpaces;
  1043.   token_start = here - 1;
  1044.   token.start = source_char_no + token_start - base;
  1045.   switch(_PL_char_types[c])
  1046.   { case LC:    { start = here-1;
  1047.           while(isAlpha(*here) )
  1048.             here++;
  1049.           c = *here;
  1050.           *here = EOS;
  1051.           token.value.atom = lookupAtom(start);
  1052.           *here = c;
  1053.           token.type = (c == '(' ? T_FUNCTOR : T_NAME);
  1054.           DEBUG(9, Sdprintf("%s: %s\n", c == '(' ? "FUNC" : "NAME",
  1055.                     stringAtom(token.value.atom)));
  1056.  
  1057.           break;
  1058.         }
  1059.     case UC:    { start = here-1;
  1060.           while(isAlpha(*here) )
  1061.             here++;
  1062.           c = *here;
  1063.           *here = EOS;
  1064.           if ( c == '(' && trueFeature(ALLOW_VARNAME_FUNCTOR) )
  1065.           { token.value.atom = lookupAtom(start);
  1066.             token.type = T_FUNCTOR;
  1067.             *here = c;
  1068.             break;
  1069.           }
  1070.           if (start[0] == '_' && here == start + 1)
  1071.           { DEBUG(9, Sdprintf("VOID\n"));
  1072.             token.type = T_VOID;
  1073.           } else
  1074.           { token.value.variable = lookupVariable(start);
  1075.             DEBUG(9, Sdprintf("VAR: %s\n",
  1076.                       token.value.variable->name));
  1077.             token.type = T_VARIABLE;
  1078.           }
  1079.           *here = c;
  1080.  
  1081.           break;
  1082.         }
  1083.     case_digit:
  1084.     case DI:    { number value;
  1085.  
  1086.           if ( get_number(&here[-1], &here, &value) &&
  1087.                !isAlpha(here[0]) )
  1088.           { token.value.number = value;
  1089.             token.type = T_NUMBER;
  1090.             break;
  1091.           } else
  1092.             syntaxError("Illegal number");
  1093.         }
  1094.     case SO:    { char tmp[2];
  1095.  
  1096.           tmp[0] = c, tmp[1] = EOS;
  1097.           token.value.atom = lookupAtom(tmp);
  1098.           token.type = (*here == '(' ? T_FUNCTOR : T_NAME);
  1099.           DEBUG(9, Sdprintf("%s: %s\n",
  1100.                   *here == '(' ? "FUNC" : "NAME",
  1101.                   stringAtom(token.value.atom)));
  1102.  
  1103.           break;
  1104.         }
  1105.     case SY:    { start = here - 1;
  1106.           while( isSymbol(*here) )
  1107.             here++;
  1108.  
  1109.           if ( here == start+1 )
  1110.           { if ( (c == '+' || c == '-') &&    /* +- number */
  1111.              !must_be_op &&
  1112.              isDigit(*here) )
  1113.             { goto case_digit;
  1114.             }
  1115.             if ( c == '.' && isBlank(*here) )    /* .<blank> */
  1116.             { token.type = T_FULLSTOP;
  1117.               break;
  1118.             }
  1119.           }
  1120.  
  1121.           end = *here, *here = EOS;
  1122.           token.value.atom = lookupAtom((char *)start);
  1123.           *here = end;
  1124.  
  1125.           token.type = (end == '(' ? T_FUNCTOR : T_NAME);
  1126.           DEBUG(9, Sdprintf("%s: %s\n",
  1127.                     end == '(' ? "FUNC" : "NAME",
  1128.                     stringAtom(token.value.atom)));
  1129.  
  1130.           break;
  1131.         }
  1132.     case PU:    { switch(c)
  1133.           { case '{':
  1134.             case '[':
  1135.               while( isBlank(*here) )
  1136.             here++;
  1137.               if (here[0] == matchingBracket(c))
  1138.               { here++;
  1139.             token.value.atom = (c == '[' ? ATOM_nil : ATOM_curl);
  1140.             token.type = here[0] == '(' ? T_FUNCTOR : T_NAME;
  1141.             DEBUG(9, Sdprintf("NAME: %s\n",
  1142.                       stringAtom(token.value.atom)));
  1143.             goto out;
  1144.               }
  1145.           }
  1146.           token.value.character = c;
  1147.           token.type = T_PUNCTUATION;
  1148.           DEBUG(9, Sdprintf("PUNCT: %c\n", token.value.character));
  1149.  
  1150.           break;
  1151.         }
  1152.     case SQ:    { char *s = get_string(here-1, &here);
  1153.  
  1154.           token.value.atom = lookupAtom(s);
  1155.           token.type = (here[0] == '(' ? T_FUNCTOR : T_NAME);
  1156.           break;
  1157.         }
  1158.     case DQ:    { char *s = get_string(here-1, &here);
  1159.           term_t t = PL_new_term_ref();
  1160.  
  1161. #if O_STRING
  1162.            if ( debugstatus.styleCheck & STRING_STYLE )
  1163.             PL_put_string_chars(t, s);
  1164.           else
  1165.             PL_put_list_chars(t, s);
  1166. #else
  1167.           PL_put_list_chars(t, s);
  1168. #endif /* O_STRING */
  1169.             token.value.term = t;
  1170.           token.type = T_STRING;
  1171.           break;
  1172.         }
  1173.     default:    { sysError("read/1: tokeniser internal error");
  1174.               break;        /* make lint happy */
  1175.         }
  1176.   }
  1177.  
  1178. out:
  1179.   token.end = source_char_no + here - base;
  1180.  
  1181.   return &token;
  1182. }
  1183.  
  1184.          /*******************************
  1185.          *       TERM-BUILDING    *
  1186.          *******************************/
  1187.  
  1188. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1189. Build a term on the global stack,  given   the  atom of the functor, the
  1190. arity and a vector of  arguments.   The  argument vector either contains
  1191. nonvar terms or a variable block. The latter looks like an atom (to make
  1192. a possible invocation of the   garbage-collector or stack-shifter happy)
  1193. and is recognised by  the  value   of  its  character-pointer,  which is
  1194. statically allocated and thus unique.
  1195. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1196.  
  1197. #define setHandle(h, w)        (*valTermRef(h) = (w))
  1198.  
  1199. static inline void
  1200. readValHandle(term_t term, Word argp)
  1201. { word w = *valTermRef(term);
  1202.   Variable var;
  1203.  
  1204.   if ( (var = isVarAtom(w)) )
  1205.   { DEBUG(9, Sdprintf("readValHandle(): var at 0x%x\n", var));
  1206.  
  1207.     if ( !var->variable )        /* new variable */
  1208.     { var->variable = PL_new_term_ref();
  1209.       setVar(*argp);
  1210.       *valTermRef(var->variable) = makeRef(argp);
  1211.     } else                /* reference to existing var */
  1212.     { *argp = *valTermRef(var->variable);
  1213.     }
  1214.   } else
  1215.     *argp = w;                /* plain value */
  1216. }
  1217.  
  1218.  
  1219. static void
  1220. build_term(term_t term, atom_t atom, int arity, term_t *argv)
  1221. { functor_t functor = lookupFunctorDef(atom, arity);
  1222.   Word argp = allocGlobal(arity+1);
  1223.  
  1224.   DEBUG(9, Sdprintf("Building term %s/%d ... ", stringAtom(atom), arity));
  1225.   setHandle(term, consPtr(argp, TAG_COMPOUND|STG_GLOBAL));
  1226.   *argp++ = functor;
  1227.  
  1228.   for( ; arity-- > 0; argv++, argp++)
  1229.     readValHandle(*argv, argp);
  1230.  
  1231.   DEBUG(9, Sdprintf("result: "); pl_write(term); Sdprintf("\n") );
  1232. }
  1233.  
  1234.  
  1235. static void
  1236. PL_assign_term(term_t to, term_t from)
  1237. { *valTermRef(to) = *valTermRef(from);
  1238. }
  1239.  
  1240.  
  1241.         /********************************
  1242.         *             PARSER            *
  1243.         *********************************/
  1244.  
  1245. #define priorityClash { syntaxError("Operator priority clash"); }
  1246.  
  1247. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1248. This part of the parser actually constructs  the  term.   It  calls  the
  1249. tokeniser  to  find  the next token and assumes the tokeniser implements
  1250. one-token pushback efficiently.  It consists  of  two  mutual  recursive
  1251. functions:  complex_term()  which is involved with operator handling and
  1252. simple_term() which reads everything, except for operators.
  1253. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1254.  
  1255. typedef struct
  1256. { atom_t op;                /* Name of the operator */
  1257.   short    kind;                /* kind (prefix/postfix/infix) */
  1258.   short    left_pri;            /* priority at left-hand */
  1259.   short    right_pri;            /* priority at right hand */
  1260.   short    op_pri;                /* priority of operator */
  1261.   term_t tpos;                /* term-position */
  1262.   unsigned char *token_start;        /* start of the token for message */
  1263. } op_entry;
  1264.  
  1265.  
  1266. typedef struct
  1267. { term_t term;                /* the term */
  1268.   term_t tpos;                /* its term-position */
  1269.   int     pri;                /* priority of the term */
  1270. } out_entry;
  1271.  
  1272.  
  1273. static bool
  1274. isOp(atom_t atom, int kind, op_entry *e)
  1275. { Operator op = isCurrentOperator(atom, kind);
  1276.   int pri;
  1277.  
  1278.   if ( op == NULL )
  1279.     fail;
  1280.   e->op     = atom;
  1281.   e->kind   = kind;
  1282.   e->op_pri = pri = op->priority;
  1283.  
  1284.   switch(op->type)
  1285.   { case OP_FX:        e->left_pri = 0;     e->right_pri = pri-1; break;
  1286.     case OP_FY:        e->left_pri = 0;     e->right_pri = pri;   break;
  1287.     case OP_XF:        e->left_pri = pri-1; e->right_pri = 0;     break;
  1288.     case OP_YF:        e->left_pri = pri;   e->right_pri = 0;     break;
  1289.     case OP_XFX:    e->left_pri = pri-1; e->right_pri = pri-1; break;
  1290.     case OP_XFY:    e->left_pri = pri-1; e->right_pri = pri;   break;
  1291.     case OP_YFX:    e->left_pri = pri;   e->right_pri = pri-1; break;
  1292.     case OP_YFY:    e->left_pri = pri;   e->right_pri = pri;   break;
  1293.   }
  1294.  
  1295.   succeed;
  1296. }
  1297.  
  1298. static void
  1299. build_op_term(term_t term, atom_t atom, int arity, out_entry *argv)
  1300. { term_t av[2];
  1301.  
  1302.   av[0] = argv[0].term;
  1303.   av[1] = argv[1].term;
  1304.   build_term(term, atom, arity, av);
  1305. }
  1306.  
  1307. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1308. realloca() maintains a buffer using  alloca()   that  has  the requested
  1309. size. The current size is maintained in   a long just below the returned
  1310. area. This is a long, to ensure   proper  allignment of the remainder of
  1311. the values.
  1312. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1313.  
  1314. #define realloca(p, unit, n) \
  1315.     { long *ip = (long *)(p); \
  1316.       if ( ip == NULL || ip[-1] < (n) ) \
  1317.       { long nsize = (((n)+(n)/2) + 3) & ~3; \
  1318.         long *np = alloca(nsize * unit + sizeof(long)); \
  1319.         *np++ = nsize; \
  1320.         if ( ip ) \
  1321.           memcpy(np, ip, ip[-1] * unit); \
  1322.         p = (void *)np; \
  1323.       } \
  1324.     }
  1325.  
  1326. #define PushOp() \
  1327.     realloca(side, sizeof(*side), side_n+1); \
  1328.     side[side_n++] = in_op; \
  1329.     side_p = (side_n == 1 ? 0 : side_p+1);
  1330.     
  1331. #define Modify(cpri) \
  1332.     if ( side_p >= 0 && cpri > side[side_p].right_pri ) \
  1333.     { term_t tmp; \
  1334.       if ( side[side_p].kind == OP_PREFIX && rmo == 0 ) \
  1335.       { DEBUG(9, Sdprintf("Prefix %s to atom\n", \
  1336.                   stringAtom(side[side_p].op))); \
  1337.         rmo++; \
  1338.         tmp = PL_new_term_ref(); \
  1339.         PL_put_atom(tmp, side[side_p].op); \
  1340.         realloca(out, sizeof(*out), out_n+1); \
  1341.         out[out_n].term = tmp; \
  1342.         out[out_n].tpos = side[side_p].tpos; \
  1343.         out[out_n].pri = 0; \
  1344.         out_n++; \
  1345.         side_n--; \
  1346.         side_p = (side_n == 0 ? -1 : side_p-1); \
  1347.       } else if ( side[side_p].kind == OP_INFIX && out_n > 0 && rmo == 0 && \
  1348.               isOp(side[side_p].op, OP_POSTFIX, &side[side_p]) ) \
  1349.       { DEBUG(9, Sdprintf("Infix %s to postfix\n", \
  1350.                   stringAtom(side[side_p].op))); \
  1351.         rmo++; \
  1352.         tmp = PL_new_term_ref(); \
  1353.         build_op_term(tmp, side[side_p].op, 1, &out[out_n-1]); \
  1354.         out[out_n-1].pri  = side[side_p].op_pri; \
  1355.         out[out_n-1].term = tmp; \
  1356.         side[side_p].kind = OP_POSTFIX; \
  1357.         out[out_n-1].tpos = opPos(&side[side_p], &out[out_n-1]); \
  1358.         side_n--; \
  1359.         side_p = (side_n == 0 ? -1 : side_p-1); \
  1360.       } \
  1361.     }
  1362.  
  1363.  
  1364. static int
  1365. get_int_arg(term_t t, int n)
  1366. { Word p = valTermRef(t);
  1367.  
  1368.   deRef(p);
  1369.  
  1370.   return valInt(argTerm(*p, n-1));
  1371. }
  1372.  
  1373.  
  1374. static term_t
  1375. opPos(op_entry *op, out_entry *args)
  1376. { if ( op->tpos )
  1377.   { int fs = get_int_arg(op->tpos, 1);
  1378.     int fe = get_int_arg(op->tpos, 2);
  1379.     term_t r = PL_new_term_ref();
  1380.  
  1381.     if ( op->kind == OP_INFIX )
  1382.     { int s = get_int_arg(args[0].tpos, 1);
  1383.       int e = get_int_arg(args[1].tpos, 2);
  1384.  
  1385.       PL_unify_term(r,
  1386.             PL_FUNCTOR,    FUNCTOR_term_position5,
  1387.             PL_INTEGER,    s,
  1388.             PL_INTEGER,    e,
  1389.             PL_INTEGER, fs,
  1390.             PL_INTEGER, fe,
  1391.             PL_LIST,    2, PL_TERM, args[0].tpos,
  1392.                        PL_TERM, args[1].tpos);
  1393.     } else
  1394.     { int s, e;
  1395.       
  1396.       if ( op->kind == OP_PREFIX )
  1397.       { s = fs;
  1398.     e = get_int_arg(args[0].tpos, 2);
  1399.       } else
  1400.       { s = get_int_arg(args[0].tpos, 1);
  1401.     e = fe;
  1402.       }
  1403.  
  1404.       PL_unify_term(r,
  1405.             PL_FUNCTOR,    FUNCTOR_term_position5,
  1406.             PL_INTEGER,    s,
  1407.             PL_INTEGER,    e,
  1408.             PL_INTEGER, fs,
  1409.             PL_INTEGER, fe,
  1410.             PL_LIST,    1, PL_TERM, args[0].tpos);
  1411.     }
  1412.     
  1413.     return r;
  1414.   }
  1415.  
  1416.   return 0;
  1417. }
  1418.  
  1419.  
  1420. static int
  1421. can_reduce(out_entry *out, op_entry *op)
  1422. { int rval;
  1423.  
  1424.   switch(op->kind)
  1425.   { case OP_PREFIX:
  1426.       rval = op->right_pri >= out[0].pri;
  1427.       break;
  1428.     case OP_POSTFIX:
  1429.       rval = op->left_pri >= out[0].pri;
  1430.       break;
  1431.     case OP_INFIX:
  1432.       rval = op->left_pri >= out[0].pri &&
  1433.          op->right_pri >= out[1].pri;
  1434.       break;
  1435.     default:
  1436.       assert(0);
  1437.       rval = FALSE;
  1438.   }
  1439.  
  1440.   return rval;
  1441. }
  1442.  
  1443. static int
  1444. bad_operator(out_entry *out, op_entry *op)
  1445. { char buf[1024];
  1446.   term_t t;
  1447.   atom_t name;
  1448.   int arity;
  1449.   char *opname = stringAtom(op->op);
  1450.  
  1451.   token_start = op->token_start;
  1452.  
  1453.   switch(op->kind)
  1454.   { case OP_INFIX:
  1455.       if ( op->left_pri < out[0].pri )
  1456.     t = out[0].term;
  1457.       else
  1458.       { token_start += strlen(opname);
  1459.     t = out[1].term;
  1460.       }
  1461.       break;
  1462.     case OP_PREFIX:
  1463.       token_start += strlen(opname);
  1464.       /*FALL THROUGH*/
  1465.     default:
  1466.       t = out[0].term;
  1467.   }
  1468.  
  1469.   if ( PL_get_name_arity(t, &name, &arity) )
  1470.   { Ssprintf(buf, "Operator `%s' conflicts with `%s'",
  1471.          opname, stringAtom(name));
  1472.   } else
  1473.   { Ssprintf(buf, "Unknown conflict with operator `%s'", opname);
  1474.   }
  1475.  
  1476.   syntaxError(buf);
  1477. }
  1478.  
  1479. #define Reduce(cpri) \
  1480.     while( out_n > 0 && side_p >= 0 && (cpri) >= side[side_p].op_pri ) \
  1481.     { int arity = (side[side_p].kind == OP_INFIX ? 2 : 1); \
  1482.       term_t tmp; \
  1483.       if ( arity > out_n ) break; \
  1484.       if ( !can_reduce(&out[out_n-arity], &side[side_p]) ) \
  1485.           { if ( (cpri) == (OP_MAXPRIORITY+1) ) \
  1486.               return bad_operator(&out[out_n-arity], &side[side_p]); \
  1487.         break; \
  1488.       } \
  1489.       DEBUG(9, Sdprintf("Reducing %s/%d\n", \
  1490.                 stringAtom(side[side_p].op), arity));\
  1491.       tmp = PL_new_term_ref(); \
  1492.       out_n -= arity; \
  1493.       build_op_term(tmp, side[side_p].op, arity, &out[out_n]); \
  1494.       out[out_n].pri  = side[side_p].op_pri; \
  1495.       out[out_n].term = tmp; \
  1496.       out[out_n].tpos = opPos(&side[side_p], &out[out_n]); \
  1497.       out_n ++; \
  1498.       side_n--; \
  1499.       side_p = (side_n == 0 ? -1 : side_p-1); \
  1500.     }
  1501.  
  1502.  
  1503. static bool
  1504. complex_term(const char *stop, term_t term, term_t positions)
  1505. { out_entry *out  = NULL;
  1506.   op_entry  *side = NULL;
  1507.   op_entry  in_op;
  1508.   int out_n = 0, side_n = 0;
  1509.   int rmo = 0;                /* Rands more than operators */
  1510.   int side_p = -1;
  1511.   term_t pin;
  1512.  
  1513.   for(;;)
  1514.   { bool isname;
  1515.     Token token;
  1516.     term_t in = PL_new_term_ref();
  1517.  
  1518.     if ( positions )
  1519.       pin = PL_new_term_ref();
  1520.     else
  1521.       pin = 0;
  1522.   
  1523.     if ( out_n != 0 || side_n != 0 )    /* Check for end of term */
  1524.     { if ( (token = get_token(rmo == 1)) == (Token) NULL )
  1525.     fail;
  1526.       unget_token();            /* only look-ahead! */
  1527.  
  1528.       switch(token->type)
  1529.       { case T_FULLSTOP:
  1530.       if ( stop == NULL )
  1531.         goto exit;
  1532.       break;
  1533.     case T_PUNCTUATION:
  1534.     { if ( stop != NULL && strchr(stop, token->value.character) )
  1535.         goto exit;
  1536.     }
  1537.       }
  1538.     }
  1539.  
  1540.                     /* Read `simple' term */
  1541.     TRY( simple_term(rmo == 1, in, &isname, pin) );
  1542.  
  1543.     if ( isname )            /* Check for operators */
  1544.     { atom_t name;
  1545.  
  1546.       PL_get_atom(in, &name);
  1547.       in_op.tpos = pin;
  1548.       in_op.token_start = token_start;
  1549.  
  1550.       DEBUG(9, Sdprintf("name %s, rmo = %d\n", stringAtom(name), rmo));
  1551.  
  1552.       if ( isOp(name, OP_INFIX, &in_op) )
  1553.       { DEBUG(9, Sdprintf("Infix op: %s\n", stringAtom(name)));
  1554.  
  1555.     Modify(in_op.left_pri);
  1556.     if ( rmo == 1 )
  1557.     { Reduce(in_op.left_pri);
  1558.       PushOp();
  1559.       rmo--;
  1560.  
  1561.       continue;
  1562.     }
  1563.       }
  1564.       if ( isOp(name, OP_POSTFIX, &in_op) )
  1565.       { DEBUG(9, Sdprintf("Postfix op: %s\n", stringAtom(name)));
  1566.  
  1567.     Modify(in_op.left_pri);
  1568.     if ( rmo == 1 )
  1569.     { Reduce(in_op.left_pri);
  1570.       PushOp();    
  1571.     
  1572.       continue;
  1573.     }
  1574.       }
  1575.       if ( rmo == 0 && isOp(name, OP_PREFIX, &in_op) )
  1576.       { DEBUG(9, Sdprintf("Prefix op: %s\n", stringAtom(name)));
  1577.     
  1578.     PushOp();
  1579.  
  1580.     continue;
  1581.       }
  1582.     }
  1583.  
  1584.     if ( rmo != 0 )
  1585.       syntaxError("Operator expected");
  1586.     rmo++;
  1587.     realloca(out, sizeof(*out), out_n+1);
  1588.     out[out_n].pri = 0;
  1589.     out[out_n].term = in;
  1590.     out[out_n++].tpos = pin;
  1591.   }
  1592.  
  1593. exit:
  1594.   Modify(OP_MAXPRIORITY+1);
  1595.   Reduce(OP_MAXPRIORITY+1);
  1596.  
  1597.   if ( out_n == 1 && side_n == 0 )    /* simple term */
  1598.   { PL_assign_term(term, out[0].term);
  1599.     if ( positions )
  1600.       PL_unify(positions, out[0].tpos);
  1601.     succeed;
  1602.   }
  1603.  
  1604.   if ( out_n == 0 && side_n == 1 )    /* single operator */
  1605.   { PL_put_atom(term, side[0].op);
  1606.     if ( positions )
  1607.       PL_unify(positions, side[0].tpos);
  1608.     succeed;
  1609.   }
  1610.  
  1611.   syntaxError("Unbalanced operators");
  1612. }
  1613.  
  1614.  
  1615. static bool
  1616. simple_term(bool must_be_op, term_t term, bool *name, term_t positions)
  1617. { Token token;
  1618.  
  1619.   *name = FALSE;
  1620.  
  1621.   if ( !(token = get_token(must_be_op)) )
  1622.     fail;
  1623.  
  1624.   switch(token->type)
  1625.   { case T_FULLSTOP:
  1626.       syntaxError("Unexpected end of clause");
  1627.     case T_VOID:
  1628.       setHandle(term, 0L);        /* variable */
  1629.       goto atomic_out;
  1630.     case T_VARIABLE:
  1631.       setHandle(term, token->value.variable->signature);
  1632.       DEBUG(9, Sdprintf("Pushed var at 0x%x\n", token->value.variable));
  1633.       goto atomic_out;
  1634.     case T_NAME:
  1635.       *name = TRUE;
  1636.       PL_put_atom(term, token->value.atom);
  1637.       goto atomic_out;
  1638.     case T_NUMBER:
  1639.       _PL_put_number(term, &token->value.number);
  1640.     atomic_out:
  1641.       if ( positions )
  1642.       { PL_unify_term(positions,
  1643.               PL_FUNCTOR, FUNCTOR_minus2,
  1644.               PL_INTEGER, token->start,
  1645.               PL_INTEGER, token->end);
  1646.       }
  1647.       succeed;
  1648.     case T_STRING:
  1649.       PL_put_term(term,    token->value.term);
  1650.       if ( positions )
  1651.       { PL_unify_term(positions,
  1652.               PL_FUNCTOR, FUNCTOR_string_position2,
  1653.               PL_INTEGER, token->start,
  1654.               PL_INTEGER, token->end);
  1655.       }
  1656.       succeed;
  1657.     case T_FUNCTOR:
  1658.       { if ( must_be_op )
  1659.     { *name = TRUE;
  1660.       PL_put_atom(term, token->value.atom);
  1661.     } else
  1662.     { term_t av[16];
  1663.       int avn = 16;
  1664.       term_t *argv = av;
  1665.       int argc;
  1666.       atom_t functor;
  1667.       term_t pa;            /* argument */
  1668.       term_t pe;            /* term-end */
  1669.       term_t ph;
  1670.  
  1671.       if ( positions )
  1672.       { pa = PL_new_term_ref();
  1673.         pe = PL_new_term_ref();
  1674.         ph = PL_new_term_ref();
  1675.         PL_unify_term(positions,
  1676.               PL_FUNCTOR, FUNCTOR_term_position5,
  1677.               PL_INTEGER, token->start,
  1678.               PL_TERM,    pe,
  1679.               PL_INTEGER, token->start,
  1680.               PL_INTEGER, token->end,
  1681.               PL_TERM,    pa);
  1682.       } else
  1683.         pa = pe = ph = 0;
  1684.  
  1685.       functor = token->value.atom;
  1686.       argc = 0, argv;
  1687.       get_token(must_be_op); /* skip '(' */
  1688.  
  1689.       do
  1690.       { if ( argc == avn )
  1691.         { term_t *nargv = alloca(sizeof(term_t) * avn * 2);
  1692.           memcpy(nargv, argv, sizeof(term_t) * avn);
  1693.           avn *= 2;
  1694.           argv = nargv;
  1695.         }
  1696.         argv[argc] = PL_new_term_ref();
  1697.         if ( positions )
  1698.         { PL_unify_list(pa, ph, pa);
  1699.         }
  1700.         TRY( complex_term(",)", argv[argc], ph) );
  1701.         argc++;
  1702.         token = get_token(must_be_op); /* `,' or `)' */
  1703.       } while(token->value.character == ',');
  1704.  
  1705.       if ( positions )
  1706.       { PL_unify_integer(pe, token->end);
  1707.         PL_unify_nil(pa);
  1708.       }
  1709.  
  1710.       build_term(term, functor, argc, argv);
  1711.     }
  1712.     succeed;
  1713.       }
  1714.     case T_PUNCTUATION:
  1715.       { switch(token->value.character)
  1716.     { case '(':
  1717.         { int start = token->start;
  1718.  
  1719.           TRY( complex_term(")", term, positions) );
  1720.           token = get_token(must_be_op);    /* skip ')' */
  1721.  
  1722.           if ( positions )
  1723.           { Word p = argTermP(*valTermRef(positions), 0);
  1724.  
  1725.         *p++ = consInt(start);
  1726.         *p   = consInt(token->end);
  1727.           }
  1728.  
  1729.           succeed;
  1730.         }
  1731.       case '{':
  1732.         { term_t arg = PL_new_term_ref();
  1733.           term_t pa, pe;
  1734.  
  1735.           if ( positions )
  1736.           { pa = PL_new_term_ref();
  1737.         pe = PL_new_term_ref();
  1738.  
  1739.         PL_unify_term(positions,
  1740.                   PL_FUNCTOR, FUNCTOR_brace_term_position3,
  1741.                   PL_INTEGER, token->start,
  1742.                   PL_TERM,      pe,
  1743.                   PL_TERM,      pa);
  1744.           } else
  1745.         pe = pa = 0;
  1746.  
  1747.           TRY( complex_term("}", arg, pa) );
  1748.           token = get_token(must_be_op);
  1749.           if ( positions )
  1750.         PL_unify_integer(pe, token->end);
  1751.           build_term(term, ATOM_curl, 1, &arg);
  1752.  
  1753.           succeed;
  1754.         }
  1755.       case '[':
  1756.         { term_t tail = PL_new_term_ref();
  1757.           term_t tmp  = PL_new_term_ref();
  1758.           term_t pa, pe, pt, p2;
  1759.  
  1760.           if ( positions )
  1761.           { pa = PL_new_term_ref();
  1762.         pe = PL_new_term_ref();
  1763.         pt = PL_new_term_ref();
  1764.         p2 = PL_new_term_ref();
  1765.  
  1766.         PL_unify_term(positions,
  1767.                   PL_FUNCTOR, FUNCTOR_list_position4,
  1768.                   PL_INTEGER, token->start,
  1769.                   PL_TERM,    pe,
  1770.                   PL_TERM,      pa,
  1771.                   PL_TERM,      pt);
  1772.           } else
  1773.         pa = pe = p2 = pt = 0;
  1774.  
  1775. /* - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
  1776. Reading a list. Tmp is used to  read   the  next element. Tail is a very
  1777. special term-ref. It is always a reference   to the place where the next
  1778. term is to be written.
  1779. - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - */
  1780.  
  1781.           PL_put_term(tail, term);
  1782.  
  1783.           for(;;)
  1784.           { Word argp;
  1785.  
  1786.         if ( positions )
  1787.           PL_unify_list(pa, p2, pa);
  1788.         TRY( complex_term(",|]", tmp, p2) );
  1789.         argp = allocGlobal(3);
  1790.         *unRef(*valTermRef(tail)) = consPtr(argp,
  1791.                             TAG_COMPOUND|STG_GLOBAL);
  1792.         *argp++ = FUNCTOR_dot2;
  1793.         readValHandle(tmp, argp++);
  1794.         setVar(*argp);
  1795.         setHandle(tail, makeRef(argp));
  1796.         
  1797.         token = get_token(must_be_op);
  1798.  
  1799.         switch(token->value.character)
  1800.         { case ']':
  1801.             { if ( positions )
  1802.               { PL_unify_nil(pa);
  1803.             PL_unify_atom(pt, ATOM_none);
  1804.             PL_unify_integer(pe, token->end);
  1805.               }
  1806.               return PL_unify_nil(tail);
  1807.             }
  1808.           case '|':
  1809.             { TRY( complex_term("]", tmp, pt) );
  1810.               argp = unRef(*valTermRef(tail));
  1811.               readValHandle(tmp, argp);
  1812.               token = get_token(must_be_op); /* discard ']' */
  1813.               if ( positions )
  1814.               { PL_unify_nil(pa);
  1815.             PL_unify_integer(pe, token->end);
  1816.               }
  1817.               succeed;
  1818.             }
  1819.           case ',':
  1820.               continue;
  1821.         }
  1822.           }
  1823.         }
  1824.       case ',':
  1825.       case '|':
  1826.       case ')':
  1827.       case '}':
  1828.       case ']':
  1829.       default:
  1830.         { static atom_t cache[256];
  1831.           int c = token->value.character;
  1832.  
  1833.           if ( !cache[c] )
  1834.           { char tmp[2];
  1835.  
  1836.         tmp[0] = c;
  1837.         tmp[1] = EOS;
  1838.         cache[c] = lookupAtom(tmp);
  1839.           }
  1840.  
  1841.           *name = TRUE; 
  1842.           PL_put_atom(term, cache[c]);
  1843.  
  1844.           succeed;
  1845.         }
  1846.     }
  1847.       } /* case T_PUNCTUATION */
  1848.     default:;
  1849.       sysError("read/1: Illegal token type (%d)", token->type);
  1850.       /*NOTREACHED*/
  1851.       fail;
  1852.   }
  1853. }
  1854.  
  1855.  
  1856. static bool
  1857. read_term(term_t term, term_t variables, term_t positions, term_t singles)
  1858. { Token token;
  1859.   term_t result;
  1860.   Word p;
  1861.  
  1862.   if ( !(base = raw_read()) )
  1863.     fail;
  1864.  
  1865.   initVarTable();
  1866.   here = base;
  1867.   unget = FALSE;
  1868.  
  1869.   result = PL_new_term_ref();
  1870.   TRY(complex_term(NULL, result, positions));
  1871.   p = valTermRef(result);
  1872.   if ( isVarAtom(*p) )            /* reading a single variable */
  1873.     readValHandle(result, p);
  1874.  
  1875.   if ( !(token = get_token(FALSE)) )
  1876.     fail;
  1877.   if (token->type != T_FULLSTOP)
  1878.     syntaxError("End of clause expected");
  1879.  
  1880.   TRY(PL_unify(term, result));
  1881.   if ( variables )
  1882.     TRY(bind_variables(variables));
  1883.   if ( singles )
  1884.     TRY(check_singletons(singles));
  1885.  
  1886.   succeed;
  1887. }
  1888.  
  1889.         /********************************
  1890.         *       PROLOG CONNECTION       *
  1891.         *********************************/
  1892.  
  1893. word
  1894. pl_raw_read(term_t term)
  1895. { char *s, *top;
  1896.  
  1897.   s = raw_read();
  1898.  
  1899.   if ( s == (char *) NULL )
  1900.     fail;
  1901.   
  1902.                     /* strip the input from blanks */
  1903.   for(top = s+strlen(s)-1; top > s && isBlank(*top); top--);
  1904.   if ( *top == '.' )
  1905.   { for(top--; top > s && isBlank(*top); top--)
  1906.       ;
  1907.   }
  1908.   top[1] = EOS;
  1909.  
  1910.   for(; isBlank(*s); s++);
  1911.  
  1912.   return PL_unify_atom_chars(term, s);
  1913. }
  1914.  
  1915.  
  1916. word
  1917. pl_raw_read2(term_t stream, term_t term)
  1918. { streamInput(stream, pl_raw_read(term));
  1919. }
  1920.  
  1921.  
  1922. word
  1923. pl_read_variables(term_t term, term_t variables)
  1924. { return read_term(term, variables, 0, FALSE);
  1925. }
  1926.  
  1927. word
  1928. pl_read_variables3(term_t stream, term_t term, term_t variables)
  1929. { streamInput(stream, pl_read_variables(term, variables));
  1930. }
  1931.  
  1932. word
  1933. pl_read(term_t term)
  1934. { return read_term(term, 0, 0, FALSE);
  1935. }
  1936.  
  1937. word
  1938. pl_read2(term_t stream, term_t term)
  1939. { streamInput(stream, pl_read(term));
  1940. }
  1941.  
  1942. word
  1943. pl_read_clause(term_t term)
  1944. { return read_term(term, 0, 0,
  1945.            debugstatus.styleCheck & SINGLETON_CHECK ? TRUE : FALSE);
  1946. }
  1947.  
  1948. word
  1949. pl_read_clause2(term_t stream, term_t term)
  1950. { streamInput(stream, pl_read_clause(term));
  1951. }
  1952.  
  1953. static const opt_spec read_term_options[] = 
  1954. { { ATOM_syntax_errors,        OPT_TERM },    /* quiet, fail, X */
  1955.   { ATOM_variable_names,    OPT_TERM },
  1956.   { ATOM_singletons,        OPT_TERM },
  1957.   { ATOM_term_position,     OPT_TERM },
  1958.   { ATOM_subterm_positions, OPT_TERM },
  1959.   { NULL_ATOM,                 0 }
  1960. };
  1961.  
  1962. word
  1963. pl_read_term(term_t term, term_t options)
  1964. { term_t syntax_errors = 0;        /* default */
  1965.   term_t varnames      = 0;
  1966.   term_t singles       = 0;
  1967.   term_t tpos           = 0;
  1968.   term_t subtpos       = 0;
  1969.   int osyntax            = give_syntaxerrors;
  1970.   int rval;
  1971.   atom_t w;
  1972.  
  1973.   if ( !scan_options(options, 0, ATOM_read_option, read_term_options,
  1974.              &syntax_errors, &varnames, &singles, &tpos, &subtpos) )
  1975.     return warning("read_term/2: illegal option list");
  1976.  
  1977.   if ( !syntax_errors ||
  1978.        (PL_get_atom(syntax_errors, &w) && w != ATOM_quiet) )
  1979.     give_syntaxerrors = TRUE;
  1980.   else
  1981.     give_syntaxerrors = FALSE;
  1982.   if ( singles && PL_get_atom(singles, &w) && w == ATOM_warning )
  1983.     singles = TRUE;
  1984.   rval = read_term(term, varnames, subtpos, singles);
  1985.   give_syntaxerrors = osyntax;
  1986.  
  1987.   if ( rval )
  1988.   { if ( tpos && source_line_no > 0 )
  1989.       TRY(PL_unify_term(tpos,
  1990.             PL_FUNCTOR, FUNCTOR_stream_position3,
  1991.             PL_INTEGER, source_char_no,
  1992.             PL_INTEGER, source_line_no,
  1993.             PL_INTEGER, 0)); /* should be charpos! */
  1994.     if ( syntax_errors && PL_is_variable(syntax_errors) )
  1995.       return PL_unify_atom(syntax_errors, ATOM_none);
  1996.   } else
  1997.   { if ( syntax_errors && PL_is_variable(syntax_errors) )
  1998.       return PL_unify_term(syntax_errors,
  1999.                PL_FUNCTOR, FUNCTOR_module2,
  2000.                  PL_FUNCTOR, FUNCTOR_stream_position3,
  2001.                    PL_INTEGER, source_char_no,
  2002.                    PL_INTEGER, source_line_no,
  2003.                    PL_INTEGER, 0, /* should be charpos! */
  2004.                  PL_CHARS, last_syntax_error);
  2005.   }
  2006.  
  2007.   return rval;
  2008. }
  2009.  
  2010. word
  2011. pl_read_term3(term_t stream, term_t term, term_t options)
  2012. { streamInput(stream, pl_read_term(term, options));
  2013. }
  2014.